home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / rbbsbas.zip / RBBSSUB5.BAS < prev   
BASIC Source File  |  1988-10-02  |  55KB  |  1,743 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB5.BAS CPC17-1A, Copyright 1986 - 88 by D. Thomas Mack'
  3. '  Copyright 1987 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB5.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: September 18, 1988
  7. '  Subsequent Releases.:
  8. '  Copyright ..........: 1986, 1987, 1988
  9. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  10. '                        RBBS-PC.BAS utilizes a lot of common subroutines.
  11. '                        Those that do not require error trapping are
  12. '                        incorporated within RBBSSUB2.BAS, RBBSSUB3.BAS,
  13. '                        RBBSSUB4.BAS and RBBSSUB5.BAS as separately
  14. '                        callable subroutines in order to free up as much
  15. '                        code as possible within the 64K code segment
  16. '                        used by RBBS-PC.BAS.
  17. '  Parameters..........: Most parameters are passed via a COMMON statement.
  18. '
  19. ' Subroutine  Line               Function of Subroutine
  20. '   Name     Number
  21. '  FILESYS    20100   File System for RBBS-PC
  22. '
  23. '  $INCLUDE: 'RBBS-VAR.BAS'
  24. '
  25. ' $SUBTITLE: 'FILESYS -- subroutine for RBBS-PC's file system'
  26. ' $PAGE
  27. '
  28. ' SUBROUTINE NAME    -- FILESYS
  29. '
  30. ' INPUT PARAMETERS   --       PARAMETER                 MEANING
  31. '                       FILESYS.PARAMETER = 1  LIST THE SYSOP'S COMMENTS FILE
  32. '                                           2  L)IST DIRECTORY COMMAND
  33. '                                           3  D)OWNLOAD COMMAND
  34. '                                           4  RETURN FROM EXTERNAL PROTOCOLS
  35. '                                           5  U)PLOAD COMMAND
  36. '                                           6  S)CAN DIRECTORY COMMAND
  37. '                                           7  P)ERSONAL FILES COMMAND
  38. '                                           8  N)EW FILES COMMAND
  39. '                                           9  RETURN FROM EXTENDED DESCRIPTION
  40. '
  41. ' OUTPUT PARAMETERS  -- FILESYS.PARAMETER = 1  COMMAND PROCESSED SUCCESSFULLY
  42. '                                           2  RECYCLE TO TOP OF RBBS-PC (202)
  43. '                                           3  PROCESS NEXT COMMAND (1200)
  44. '                                           4  DENY USER ACCESS (1380)
  45. '                                           5  HANDLE EXTENDED DESCRIP. (2008)
  46. '                                           6  USER'S TIME EXCEEDED (10553)
  47. '                                           7  CARRIER DROPPED (10595)
  48. '
  49. ' SUBROUTINE PURPOSE -- TO HANDLE THE RBBS-PC FILE SYSTEM COMMANDS
  50. '
  51.       SUB FILESYS STATIC
  52.       FF = FILESYS.PARAMETER
  53.       FILESYS.PARAMETER = 1
  54.       ON FF GOSUB 20119, _  ' HANDLER TO LIST COMMENTS TO SYSOP
  55.                   20150, _  ' L)IST DIRECTORY COMMAND HANDLER
  56.                   20180, _  ' D)OWNLOAD COMMAND HANDLER
  57.                   20262, _  ' RETURN FROM EXTERNAL PROTOCOL'S
  58.                   20400, _  ' U)PLOAD COMMAND HANDLER
  59.                   21800, _  ' S)CAN DIRECTORY COMMAND HANDLER
  60.                   21850, _  ' P)ERSONAL FILES COMMAND HANDLER
  61.                   21860, _  ' N)EW FILES COMMAND HANDLER
  62.                   20705     ' RETURN FROM EXTENDED DESCRIPTIONS
  63.       ON FILESYS.PARAMETER GOTO 21920, _ ' NORMAL EXIT
  64.                                 21570, _ ' RECYCLE TO TOP OR RBBS-PC
  65.                                 21580, _ ' PROCESS NEXT COMMAND
  66.                                 21590, _ ' DENY USER ACCESS
  67.                                 21600, _ ' HANDLE EXTENDED DESCRIPTIONS
  68.                                 21610, _ ' USER'S TIME EXCEEDED
  69.                                 21620    ' CARRIER DROPPED
  70. 20119 EC = 0
  71.       GOTO 20122
  72. '
  73. ' *****  SCAN DIRECTORIES (PRINT TEXT)  *****
  74. '
  75. '  (formerly lines 7000 to 7260 in RBBS-PC.BAS CPC16-1A
  76. 20120 A$ = "Scanning Directory " + _
  77.            FILE.NAME.HOLD$ + _
  78.            " for " + _
  79.            RS$
  80.       GOSUB 21650
  81.       IF FILESYS.PARAMETER > 1 THEN _
  82.          RETURN
  83.       PG = TRUE
  84. 20122 CALL OPENWORK (FILE.NAME$)
  85.       IF EC = 53 THEN _
  86.          CALL UPDTCALR ("Missing File " + FILE.NAME$,2) : _
  87.          A$ = "Missing file " + _
  88.               FILE.NAME$ + _
  89.               ". Please tell SYSOP" : _
  90.          GOSUB 21650 : _
  91.          RETURN
  92. 20124 CALL CARRIER
  93.       IF EOF(2) OR _
  94.          (SUBROUTINE.PARAMETER AND NOT LOCAL.USER) THEN _
  95.          GOTO 20142
  96. 20126 CALL READDIR (1)
  97.      IF EC <> 0 THEN _
  98.         EL = 20126 : _
  99.         GOTO 21900
  100.      IF CK = 0 THEN _
  101.         GOTO 20140
  102.      IF LEN(A$) > 0 THEN IF ASC(A$) = 32 THEN _
  103.         IF LAST.OK AND NOT EXTENDED.OFF THEN _
  104.            GOTO 20140 _
  105.         ELSE GOTO 20124
  106.      LAST.OK = FALSE
  107. 20128 IF CK > 1 THEN _
  108.          IF WILD.SEARCH THEN _
  109.             A = INSTR(A$," ") : _
  110.             IF A = 0 THEN _
  111.                GOTO 20124 _
  112.             ELSE Z$ = LEFT$(A$,A - 1) : _
  113.                  CALL WILDFILE (RS$,Z$,XXX) : _
  114.                  GOTO 20136_
  115.          ELSE Z$ = A$ : _
  116.               CALL ALLCAPS (Z$) : _
  117.               XXX = (INSTR(Z$,RS$) = 0) : _
  118.               GOTO 20136
  119. 20130 A = INSTR(9,MID$(A$,1,32),"/")
  120.       IF A = 0 THEN _
  121.          A = INSTR(9,MID$(A$,1,32),"-")
  122. 20132 IF A < 3 THEN _
  123.          GOTO 20124
  124.       IF INSTR("0123456789",MID$(A$,A - 1,1)) = 0 THEN _
  125.          GOTO 20124
  126.       A = A - 2
  127.       WK$ = RIGHT$(MID$(A$,A,8),2) + _
  128.             LEFT$(MID$(A$,A,8),2) + _
  129.             MID$(MID$(A$,A,8),4,2)
  130.       IF MID$(WK$,3,1) = " " THEN _
  131.          MID$(WK$,3,1) = "0"
  132.       IF MID$(WK$,5,1) = " " THEN _
  133.          MID$(WK$,5,1) = "0"
  134. 20134 XXX = (WK$ < RS$)
  135. 20136 IF XXX THEN _
  136.          GOTO 20124
  137.       IF PG THEN _
  138.          PG = FALSE : _
  139.          CALL OPENWORK (FILE.NAME$) : _
  140.          Q = 0 : _
  141.          GOTO 20124
  142. 20138 IF PG THEN _
  143.          GOTO 20124
  144. 20140 LAST.OK = TRUE
  145.       GOSUB 21650
  146.       IF FILESYS.PARAMETER > 1 THEN _
  147.          RETURN
  148.       CALL ASKMORE ("",TRUE,TRUE,LIST.INDEX,FALSE)
  149.       IF NO THEN _
  150.          EC = 0 : _
  151.          RETURN
  152.       IF NOT RET THEN _
  153.          GOTO 20124
  154. 20142 Q = 0
  155.       CLOSE 2
  156.       CALL CARRIER
  157.       IF SUBROUTINE.PARAMETER = -1 THEN _
  158.          FILESYS.PARAMETER = 7
  159.       RETURN
  160. '
  161. ' *  L - COMMAND FROM FILES MENU (LIST DIRECTORY)                             *
  162. '
  163. 20150 LIST.DIRECTORY = TRUE
  164.       LIST.NEW = FALSE
  165.       SEARCH.DATE$ = ""
  166.       SEARCH.STRING$ = ""
  167.       SEARCHING.ALL = FALSE
  168.       SHOW.DIR.OF.DIR = NOT EXPERT.USER
  169.       CK = 0
  170.       IF Q > 1 THEN _
  171.          CALL ALLCAPS (B$(2)) : _
  172.          IF B$(2) = "L" THEN _
  173.             SHOW.DIR.OF.DIR = TRUE _
  174.          ELSE LIST.INDEX = 2 : _
  175.               GOTO 20159
  176. 20158 IF LIST.NEW OR LIST.INDEX > 255 THEN _
  177.          LIST.INDEX = 0 : _
  178.          RETURN
  179.       LIST.INDEX = 1
  180.       CALL GETDIRS (SHOW.DIR.OF.DIR)
  181.       IF Q = 0 THEN _
  182.          RETURN
  183.       SHOW.DIR.OF.DIR = FALSE
  184. 20159 CALL CONVDIRS (LIST.INDEX)
  185.       QX = Q
  186. 20160 CALL CARRIER
  187.       IF SUBROUTINE.PARAMETER = -1 THEN _
  188.          FILESYS.PARAMETER = 7 : _
  189.          RETURN
  190.       IF LIST.INDEX <= QX THEN _
  191.          GOTO 20161
  192.       IF NO OR (FILE.NAME.HOLD$ = DIRECTORY.PREFIX$) THEN _
  193.          REDIM A$(ADIM) : _
  194.          REDIM B$(ADIM) : _
  195.          GOTO 20158
  196.       CALL QTPUT (EMPHASIZE.OFF$,0)
  197.       A$ = "End list.  R)elist, [Q]uit, or download what"
  198.       GOSUB 21660
  199.       IF FILESYS.PARAMETER > 1 THEN _
  200.          RETURN
  201.       CALL ALLCAPS (B$(1))
  202.       IF B$(1) = "R" THEN _
  203.          LIST.INDEX = LIST.INDEX - 1 : _
  204.          B$(LIST.INDEX) = A1$ : _
  205.          GOTO 20161
  206.       IF LEN(B$(1)) > 1 AND _
  207.          USER.SECURITY.LEVEL >= OPT.SEC(19 - 20 * (MENU.INDEX = 6)) THEN _
  208.          B = 1 : _
  209.          GOSUB 20202 : _
  210.          IF FILESYS.PARAMETER > 1 THEN _
  211.             RETURN _
  212.          ELSE CALL LINE25
  213.       GOTO 20158
  214. 20161 IF INSTR(B$(LIST.INDEX),".") THEN _
  215.          GOTO 20172
  216.       VIOLATION$ = "List Dir. "
  217.       Z$ = B$(LIST.INDEX)
  218.       A = INSTR("E+E-E",Z$)
  219.       IF A > 0 THEN _
  220.          IF A = 5 THEN _
  221.             EXTENDED.OFF = NOT EXTENDED.OFF : _
  222.             GOTO 20175 _
  223.          ELSE EXTENDED.OFF = (A > 2) : _
  224.               GOTO 20175
  225.       CALL ALLCAPS(Z$)
  226.       FILE.NAME.HOLD$ = Z$
  227.       A1$ = Z$
  228.       IF Z$ = DIRECTORY.PREFIX$ THEN _
  229.          GOTO 20164
  230.       IN.FMS = FALSE
  231. 20162 FOR I = 2 TO QX
  232.          A$(I) = B$(I)
  233.       NEXT
  234.       CALL FMS (Z$,SEARCH.STRING$,SEARCH.DATE$,IN.FMS, _
  235.                 CATEGORY.NAME$(),CATEGORY.CODE$(),CATEGORY.DESC$(),_
  236.                 DOWNLOAD.FLAG,CAT.FOUND,LIST.INDEX)
  237.       WHILE DOWNLOAD.FLAG > 0 AND SUBROUTINE.PARAMETER > -1
  238.          B = 1
  239.          GOSUB 20202
  240.          IF FILESYS.PARAMETER > 1 THEN _
  241.             RETURN
  242.          X$ = CATEGORY.CODE$(CAT.FOUND)
  243.          CALL DISUPDIR (X$,SEARCH.STRING$,SEARCH.DATE$,DOWNLOAD.FLAG,LIST.INDEX)
  244.          CALL CHKTREMAIN (TIME.REMAINING!)
  245.          IF SUBROUTINE.PARAMETER = -1 THEN _
  246.             FILESYS.PARAMETER = 6 : _
  247.             RETURN
  248.          CALL CARRIER
  249.       WEND
  250.       IF SUBROUTINE.PARAMETER = -1 THEN _
  251.          FILESYS.PARAMETER = 7 : _
  252.          RETURN
  253.       FOR I = 2 TO QX
  254.          B$(I) = A$(I)
  255.       NEXT
  256.       ACTIVE.FMS.DIRECTORY$ = ""
  257.       IF IN.FMS THEN _
  258.          GOTO 20175
  259.       IF USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW THEN _
  260.          IF FILE.NAME.HOLD$ = UPLOAD.DIR.CHECK$ THEN _
  261.             FILE.NAME.HOLD$ = "of uploads" : _
  262.             GOTO 20172
  263.       FILE.NAME.HOLD$ = B$(LIST.INDEX)
  264.       IF LIMIT.SEARCH.TO.FMS THEN _
  265.          GOTO 20166
  266.       IF FILE.NAME.HOLD$ = "ALL" OR FILE.NAME.HOLD$ = "A" THEN _
  267.          SEARCHING.ALL = TRUE : _
  268.          DIR.INDEX = LIST.INDEX : _
  269.          GOTO 21890
  270.       CALL BADFILE (FILE.NAME.HOLD$,BAD.FILE.NAME.INDEX)
  271.       ON BAD.FILE.NAME.INDEX GOTO 20163,20172,20176
  272. 20163 FILE.NAME$ = FILE.NAME.HOLD$
  273.       CALL BADNAME (BAD.FILE.NAME.INDEX)
  274.       ON BAD.FILE.NAME.INDEX GOTO 20164,20176
  275. 20164 IF FILE.NAME$ = UPLOAD.DIR.CHECK$ AND _
  276.          USER.SECURITY.LEVEL >= MIN.SEC.TO.VIEW THEN _
  277.             FILE.NAME$ = UPLOAD.PATH$ _
  278.       ELSE FILE.NAME$ = DIRECTORY.PATH$
  279.       FILE.NAME$ = FILE.NAME$ + _
  280.                    FILE.NAME.HOLD$ + _
  281.                    "." + _
  282.                    DIRECTORY.EXTENTION$
  283.       CALL GRAPHIC (USER.GRAPHIC.DEFAULT$)
  284. 20165 IF OK THEN _
  285.          CALL READDIR (1) : _
  286.          IF EC = 0 THEN _
  287.             IF LEFT$(A$,4) = "\FMS" THEN _
  288.                IN.FMS = TRUE : _
  289.                ACTIVE.FMS.DIRECTORY$ = FILE.NAME$ : _
  290.                GOTO 20162 _
  291.             ELSE GOTO 20167
  292. 20166 FILE.NAME$ = DIRECTORY.PATH$ + _
  293.                    FILE.NAME.HOLD$ + ".MNU"
  294.       CALL FINDIT (FILE.NAME$)
  295.       IF OK THEN _
  296.          CALL BUFFILE (FILE.NAME$,LIST.INDEX) : _
  297.          GOTO 20158
  298.       IF ALTDIR.EXTENSION$ = "" THEN _
  299.          GOTO 20172
  300.       FILE.NAME$ = DIRECTORY.PATH$ + _
  301.                    FILE.NAME.HOLD$ + _
  302.                    "." + _
  303.                    ALTDIR.EXTENSION$
  304.       CALL GRAPHIC (USER.GRAPHIC.DEFAULT$)
  305.       IF NOT OK THEN _
  306.          GOTO 20172
  307. 20167 B$(0) = B$(LIST.INDEX)
  308.       IF NOT LIST.NEW THEN _
  309.          GOTO 20168
  310.       GOSUB 20120
  311.       IF FILESYS.PARAMETER > 1 THEN _
  312.          RETURN
  313.       GOTO 20170
  314. 20168 CALL BUFFILE(FILE.NAME$,LIST.INDEX)
  315.       CALL CARRIER
  316.       IF SUBROUTINE.PARAMETER = -1 THEN _
  317.          FILESYS.PARAMETER = 7 : _
  318.          RETURN
  319. 20170 IF LIST.INDEX > 255 THEN _
  320.          LIST.INDEX = 0 : _
  321.          RETURN
  322.       B$(LIST.INDEX) = B$(0)
  323.       GOTO 20175
  324. 20172 IF NOT SEARCHING.ALL THEN _
  325.          A$ = "Directory " + _
  326.               FILE.NAME.HOLD$ + _
  327.               " not found!" : _
  328.          GOSUB 21640 : _
  329.          NO = TRUE : _
  330.          IF FILESYS.PARAMETER > 1 THEN _
  331.             RETURN
  332. 20175 LIST.INDEX = LIST.INDEX + 1
  333.       GOTO 20160
  334. 20176 CALL SVIOLATION
  335.       IF DENY.ACCESS THEN _
  336.          FILESYS.PARAMETER = 4 : _
  337.          RETURN
  338.       GOTO 20172
  339. '
  340. ' *  D - COMMAND FROM FILES MENU (SEARCH FOR FILE TO DOWNLOAD)                *
  341. '
  342. 20180 IF Q > 1 THEN _
  343.          B = 2 : _
  344.          GOTO 20202
  345. 20200 A$ = "Download what file(s)"
  346.       GOSUB 21660
  347.       IF FILESYS.PARAMETER > 1 THEN _
  348.          RETURN
  349.       B = 1
  350.       IF Q = 0 THEN _
  351.          RETURN
  352. 20202 IF (TIME.LOCK AND 2) AND NOT TIME.LOCK.EXEMPT THEN _
  353.          CALL TIMELOCK : _
  354.          IF NOT OK THEN _
  355.             RETURN
  356.       LAST.DOWNLOAD = Q
  357.       FIRST.DOWNLOAD = B
  358.       COMMAND.TRANSFER$ = ""
  359.       IF AUTODOWNLOAD.AVAILABLE THEN _
  360.          COMMAND.TRANSFER$ = "X"
  361.       AUTODOWNLOAD.IN.PROGRESS = AUTODOWNLOAD.AVAILABLE
  362.       IF LAST.DOWNLOAD > FIRST.DOWNLOAD THEN _
  363.          Z$ = B$(LAST.DOWNLOAD) : _
  364.          CALL ALLCAPS(Z$) : _
  365.          IF LEN (Z$) = 1 AND INSTR(LEFT$(DFLTXFER$,LEN(DFLTXFER$)-1),Z$) > 0 THEN _
  366.             LAST.DOWNLOAD = LAST.DOWNLOAD - 1 : _
  367.             COMMAND.TRANSFER$ = Z$ : _
  368.             AUTODOWNLOAD.IN.PROGRESS = FALSE
  369.       BATCH.BYTES# = 0
  370.       BATCH.BLOCKS# = 0
  371.       CALL KILLWORK (NODE.WORK.FILE$)
  372.       EC = 0
  373.       FOR DWN.INDEX = FIRST.DOWNLOAD TO LAST.DOWNLOAD
  374.          GOSUB 20205
  375.          IF FILESYS.PARAMETER > 1 THEN _
  376.             DWN.INDEX = LAST.DOWNLOAD + 1
  377. 20203 NEXT
  378.       IF FILESYS.PARAMETER > 1 THEN _
  379.          RETURN
  380.       BATCH.TRANSFER = FALSE
  381.       COMMAND.TRANSFER$ = ""
  382.       RETURN
  383. 20205 MARK.TIME = (DWN.INDEX = FIRST.DOWNLOAD OR NOT CONCAT.FILES)
  384.       FILE.NAME$ = B$(DWN.INDEX)
  385.       VIOLATION$ = "Download "
  386.       IF PERSONAL.DOWNLOAD THEN _
  387.          CALL BRKFNAME (FILE.NAME$,DR$,Y$,X$,TRUE) : _
  388.          FILE.NAME.HOLD$ = Y$ + _
  389.                            X$ : _
  390.          GOTO 20235
  391.       FILE.NAME.HOLD$ = FILE.NAME$
  392.       CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)
  393.       ON BAD.FILE.NAME.INDEX GOTO 20220,20231,20233
  394. 20220 CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT + _
  395.                       ((USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW) OR _
  396.                        NOT CAN.DOWNLOAD.FROM.UP),MARK.TIME)
  397. 20225 IF OK THEN _
  398.          GOTO 20235
  399. 20231 A$ = FILE.NAME.HOLD$ + _
  400.            " not found!"
  401.       CALL UPDTCALR (A$,2)
  402.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  403.          A$ = A$ + _
  404.               " during AUTODOWNLOAD" : _
  405.          GOSUB 21640 : _
  406.          RETURN
  407.       A$ = A$ + _
  408.            " Correct name"+PRESS.ENTER.EXPERT$
  409.       GOSUB 21660
  410.       IF FILESYS.PARAMETER > 1 THEN _
  411.          RETURN
  412.       IF Q=0 THEN _
  413.          RETURN
  414.       B$(DWN.INDEX) = B$(1)
  415.       GOTO 20205
  416. 20233 CALL SVIOLATION
  417.       IF DENY.ACCESS THEN _
  418.          FILESYS.PARAMETER = 4 : _
  419.          RETURN
  420.       GOTO 20231
  421. 20235 CALL BADNAME (BAD.FILE.NAME.INDEX)
  422.       ON BAD.FILE.NAME.INDEX GOTO  20236,20245
  423. 20236 LINE.25$ = "(D) " + _
  424.                  Z$
  425.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  426.          MID$(LINE.25$,2,1) = "A"
  427. '
  428. ' *  TEST FOR DOWNLOAD SECURITY                                               *
  429. '
  430.       CALL OPENWORK (FILESEC.FILE$)
  431.       IF EC = 53 THEN _
  432.          CALL UPDTCALR ("Missing file " + FILESEC.FILE$,2) : _
  433.          GOTO 20247
  434. 20242 IF EOF(2) THEN _
  435.          GOTO 20247
  436.       CALL READPARMS (WORK.ARA$(),3,1)
  437.       IF EC <> 0 THEN _
  438.          EL = 20242 : _
  439.          GOTO 21900
  440. 20243 CALL WILDFILE (WORK.ARA$(1),Z$,OK)
  441.       IF NOT OK THEN _
  442.          GOTO 20242
  443. 20244 IF USER.SECURITY.LEVEL < VAL(WORK.ARA$(2)) THEN _
  444.          GOTO 20245
  445.       FILE.PASSWORD$ = WORK.ARA$(3)
  446.       IF FILE.PASSWORD$ = "" THEN _
  447.          GOTO 20247
  448.       CALL ALLCAPS (FILE.PASSWORD$)
  449.       IF FILE.PASSWORD$ = PASSWORD$ THEN _
  450.          GOTO 20247
  451.       A$ = "Enter PASSWORD to download " + _
  452.            FILE.NAME$
  453.       GOSUB 21660
  454.       IF FILESYS.PARAMETER > 1 THEN _
  455.          RETURN
  456.       IF Q = 0 THEN _
  457.          RETURN
  458.       CALL ALLCAPS (B$(1))
  459.       IF B$(1) = FILE.PASSWORD$ THEN _
  460.          GOTO 20247
  461. 20245 VIOLATION$ = "DownLoad " + _
  462.                    FILE.NAME$
  463. 20246 CALL SVIOLATION
  464.       IF DENY.ACCESS THEN _
  465.          FILESYS.PARAMETER = 4
  466.       RETURN
  467. 20247 DF = 0
  468.       CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,FALSE)
  469.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  470.          A$ = "Transferring -- " + _
  471.               B$(DWN.INDEX) : _
  472.          GOSUB 21640 : _
  473.          IF FILESYS.PARAMETER > 1 THEN _
  474.             RETURN
  475.       IF EXTENTION$ = "" OR RELIABLE.MODE OR _
  476.          COMMAND.TRANSFER$ > "A" OR (USER.TRANSFER.DEFAULT$ > "A" AND _
  477.          INTERNAL.PROTO$ <> "N") THEN _
  478.             GOTO 20248
  479.       IF INSTR(".WRK.FW .ARC.EXE.COM.OBJ.WKS.LBR",EXTENTION$) OR _
  480.          MID$(EXTENTION$,2,1) = "Q" OR _
  481.          (REQUIRE.NON.ASCII AND EXTENTION$ = "BAS") THEN _
  482.          CALL QTPUT ("Non-ASCII required for " + FILE.NAME.HOLD$,1) : _
  483.          DF = TRUE
  484. 20248 A$ = ""
  485.       IF BATCH.TRANSFER THEN _
  486.          IF DWN.INDEX < LAST.DOWNLOAD THEN _
  487.             GOTO 20260
  488.       CALL XFERTYPE (2,TRUE)
  489.       IF FF THEN _
  490.          GOTO 20260
  491.       CALL XFERTYPE (1,TRUE)
  492.       IF SUBROUTINE.PARAMETER = -1 THEN _
  493.          RETURN
  494. 20260 TRANSFER.FUNCTION = 1
  495.       GOSUB 21790
  496.       IF FILESYS.PARAMETER > 1 THEN _
  497.          RETURN
  498.       BATCH.TRANSFER = (BATCH.PROTO AND (LAST.DOWNLOAD > FIRST.DOWNLOAD))
  499.       IF BATCH.TRANSFER AND COMMAND.TRANSFER$ = "" THEN _
  500.          COMMAND.TRANSFER$ = FT$
  501.       ON INSTR("AXCYN",INTERNAL.PROTO$) GOTO _
  502.          20340, _              ' ASCII DOWNLOAD
  503.          20290, _              ' XMODEM
  504.          20290, _              ' XMODEM CRC
  505.          20270, _              ' YMODEM
  506.          21700                 ' NONE - CANCEL
  507. '
  508. ' *  EXTERNAL PROTOCOL DOWNLOADS/UPLOADS                           *
  509. '
  510. 20261 IF REQ.8.BIT THEN _
  511.          IF NOT EIGHT.BIT THEN _
  512.             GOSUB 20318 : _
  513.             IF FILESYS.PARAMETER > 1 THEN _                          ' DTM0828
  514.                RETURN _                                              ' DTM0828
  515.             ELSE GOSUB 20992 : _                                     ' DTM0828
  516.                  IF FILESYS.PARAMETER > 1 THEN _
  517.                     RETURN
  518.       IF TRANSFER.FUNCTION = 1 THEN _
  519.          GOSUB 20750 : _
  520.          CLOSE 2 : _                                                 ' DTM0828
  521.          IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  522.             RETURN                                                   ' DTM0828
  523.       IF BATCH.TRANSFER THEN _
  524.          IF DWN.INDEX < LAST.DOWNLOAD THEN _
  525.             RETURN _
  526.          ELSE BLOCKS.IN.FILE# = BATCH.BLOCKS# : _
  527.               BYTES.IN.FILE# = BATCH.BYTES# : _
  528.               NUM.DNLD.BYTS! = BATCH.BYTES# : _                      ' DTM0828
  529.               GOSUB 20780 : _
  530.               IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  531.                 RETURN                                               ' DTM0828
  532.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  533.          CALL SENDNAME : _
  534.          IF ABORT THEN _
  535.             DOWNLOAD.COMPLETED = FALSE : _
  536.             GOSUB 21760 : _                                          ' DTM0828
  537.             RETURN
  538.       CALL TRANSFER
  539. 20262 CALL CARRIER
  540.       IF SUBROUTINE.PARAMETER = -1 THEN _
  541.          A$ = FAILURE.STRING$ : _
  542.          GOTO 20264
  543.       IF PRIVATE.DOOR THEN _
  544.          COMMAND.TRANSFER$ = FT$ : _
  545.          CALL XFERTYPE (2,TRUE) : _
  546.          COMMAND.TRANSFER$ = ""
  547.       CALL OPENWORK ("XFER-" + NODE.ID$ + ".DEF")
  548.       IF EC <> 0 THEN _
  549.          GOTO 20267
  550.       CALL READPARMS (WORK.ARA$(), FAILURE.PARM, 1)
  551.       IF EC <> 0 THEN _
  552.          GOTO 20267
  553.       CALL KILLWORK ("XFER-" + NODE.ID$ + ".DEF")
  554. 20264 IF PRIVATE.DOOR THEN _
  555.          PRIVATE.DOOR = FALSE : _
  556.          FILE.NAME$ = WORK.ARA$(1) : _
  557.          CALL BRKFNAME (FILE.NAME$,X$,FILE.NAME.HOLD$,Y$,TRUE) : _
  558.          FILE.NAME.HOLD$ = FILE.NAME.HOLD$ + _
  559.                            Y$ : _
  560.          SIZE.ONLY = TRUE : _
  561.          CALL OPENWORK (FILE.NAME$) : _
  562.          GOSUB 20760 : _
  563.          IF FILESYS.PARAMETER > 1 THEN _
  564.             RETURN
  565. 20265 IF TRANSFER.FUNCTION = 2 THEN _
  566.          IF INSTR(WORK.ARA$(FAILURE.PARM),FAILURE.STRING$) <> 1 THEN _
  567.             GOTO 20700 _
  568.          ELSE GOTO 20730
  569.       IF TRANSFER.FUNCTION = 1 THEN _
  570.          DOWNLOAD.COMPLETED = (INSTR(WORK.ARA$(FAILURE.PARM),FAILURE.STRING$) <> 1)
  571.       GOSUB 21760
  572.       RETURN
  573. '
  574. ' *  XFER FILE NOT FOUND                                                      *
  575. '
  576. 20267 EL = 20262
  577.       GOTO 21900
  578.  
  579. '
  580. ' *  YMODEM DOWNLOAD DRIVER                                                   *
  581. '
  582. 20270 GOTO 20292
  583. '
  584. ' *  XMODEM DOWNLOAD DRIVER                                                   *
  585. '
  586. 20290 '
  587. 20292 GOSUB 20750
  588.       IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  589.          RETURN
  590.       A1$ = "SEND"
  591.       GOSUB 20320
  592.       IF FILESYS.PARAMETER > 1 THEN _
  593.          RETURN
  594.       IF LOCAL.USER THEN _
  595.          CALL QTPUT ("Protocol not available in local mode",1) : _
  596.          RETURN
  597.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  598.          GOSUB 20294 : _
  599.          IF ABORT THEN _
  600.             RETURN
  601.       GOSUB 21300
  602.       IF FILESYS.PARAMETER > 1 THEN _
  603.          RETURN
  604.       A$ = ""
  605.       GOTO 20390
  606. 20294 CALL SENDNAME
  607.       RETURN
  608. 20318 A$ = "Please SWITCH to N,8,1 for binary transfer"
  609.       GOSUB 21630
  610.       IF FILESYS.PARAMETER > 1 THEN _
  611.          RETURN
  612.       CALL DELAYIT (3)
  613.       RETURN
  614. 20320 IF NOT EIGHT.BIT THEN _
  615.          GOSUB 20318 : _
  616.          IF FILESYS.PARAMETER > 1 THEN _
  617.             RETURN
  618. 20325 IF CHECKSUM THEN _
  619.          NEGATIVE.ACKNOWLEDGE$ = CHR$(21) : _
  620.          SOL = 132 _
  621.       ELSE NEGATIVE.ACKNOWLEDGE$ = "C" : _
  622.            SOL = 133
  623. 20330 IF AUTODOWNLOAD.IN.PROGRESS THEN _
  624.          RETURN
  625.       A$ = PROTO.PROMPT$ + _
  626.             " " + A1$ + _
  627.             " of " + _
  628.             FILE.NAME.HOLD$ + _
  629.             " ready.  <Ctrl X> aborts"
  630.       GOSUB 21650
  631.       RETURN
  632. '
  633. ' *  ASCII DOWNLOAD DRIVER                                                    *
  634. '
  635. 20340 IF DF THEN _
  636.          A$ = "Switch to a non-ascii protocol" : _
  637.          GOSUB 21650 : _
  638.          RETURN
  639.       GOSUB 20750
  640.       IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  641.          RETURN
  642.       CALL OPENWORK (FILE.NAME$)
  643.       IF (DWN.INDEX = FIRST.DOWNLOAD OR NOT CONCAT.FILES) THEN _
  644.          A$ = "^X aborts.  ^S suspends ^Q resumes" : _
  645.          GOSUB 21640 : _
  646.          IF FILESYS.PARAMETER > 1 THEN _
  647.             RETURN _
  648.          ELSE A$ = PROTO.PROMPT$ + " SEND of " + _
  649.               FILE.NAME.HOLD$ + _
  650.               " ready. Press Any Key to start" : _
  651.          TURBO.KEY = 2 : _
  652.          GOSUB 21660 : _
  653.          IF FILESYS.PARAMETER > 1 THEN _
  654.             RETURN
  655. 20380 STOP.INTERRUPTS = FALSE
  656.       TU = 0
  657.       SWAP TU,PAGE.LENGTH
  658.       CALL BUFFILE (FILE.NAME$,X)
  659.       SWAP TU,PAGE.LENGTH
  660.       NON.STOP = (PAGE.LENGTH < 1)
  661.       IF STOP.FILE THEN _
  662.          DOWNLOAD.COMPLETED = FALSE : _
  663.          GOTO 20390
  664. 20381 IF (DWN.INDEX = LAST.DOWNLOAD OR NOT CONCAT.FILES) THEN _
  665.          CALL QTPUT (CHR$(26),0) : _
  666.          IF NOT LOCAL.USER AND SUBROUTINE.PARAMETER = 0 THEN _
  667.             FOR X = 1 TO 5 : _
  668.                CALL PUTCOM (CHR$(7)) : _
  669.                CALL DELAYIT (3) : _
  670.             NEXT
  671. 20385 DOWNLOAD.COMPLETED = TRUE
  672. 20390 GOTO 21760
  673. '
  674. ' *  U - COMMAND FROM FILES MENU (UPLOAD)                                     *
  675. '
  676. 20395 GOSUB 21640
  677.       IF FILESYS.PARAMETER > 1 THEN _
  678.          RETURN
  679.       A$ = "Correct name of file to upload" + _
  680.            PRESS.ENTER.EXPERT$
  681.       GOSUB 21660
  682.       IF FILESYS.PARAMETER > 1 THEN _
  683.          RETURN
  684.       IF Q = 0 THEN _
  685.          RETURN
  686.       B$(ANS.INDEX) = B$(1)
  687.       GOTO 20435
  688. 20400 CALL TIMEREMAIN (TIME.REMAINING!)
  689.       Q! = TCA!
  690.       FIRST.UPLOAD = 1
  691.       IF Q > 1 THEN _
  692.          FIRST.UPLOAD = 2 : _
  693.          GOTO 20430
  694.       GOSUB 20420
  695.       GOTO 20430
  696. 20420 A$ = "Upload what file(s)"
  697.       GOSUB 21660
  698.       IF FILESYS.PARAMETER > 1 THEN _
  699.          RETURN
  700.       IF Q = 0 THEN _
  701.          RETURN
  702.       RETURN
  703. '
  704. ' *  SEARCH FOR DUPLICATE FILENAME                                            *
  705. '
  706. 20430 LAST.UPLOAD = Q
  707.       Z$ = B$(LAST.UPLOAD)
  708.       IF LEN(Z$) = 1 THEN _
  709.          CALL ALLCAPS (Z$) : _
  710.          IF INSTR(DFLTXFER$,Z$) > 0 THEN _
  711.             LAST.UPLOAD = LAST.UPLOAD - 1 : _
  712.             COMMAND.TRANSFER$ = Z$
  713.       FOR ANS.INDEX = FIRST.UPLOAD TO LAST.UPLOAD
  714.          GOSUB 20435
  715.          IF FILESYS.PARAMETER > 1 THEN _
  716.             ANS.INDEX = LAST.UPLOAD + 1
  717.       NEXT
  718.       COMMAND.TRANSFER$ = ""
  719.       RETURN
  720. 20435 FILE.NAME.HOLD$ = B$(ANS.INDEX)
  721.       CALL ALLCAPS(FILE.NAME.HOLD$)
  722.       FILE.NAME$ = FILE.NAME.HOLD$
  723.       VIOLATION$ = "Upload "
  724.       IF INSTR(FILE.NAME$,":") OR _
  725.          INSTR(FILE.NAME$,"\") OR _
  726.          INSTR(FILE.NAME$,"/") THEN _
  727.          GOTO 20451
  728.       CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)
  729.       ON BAD.FILE.NAME.INDEX GOTO 20440,20451,20515
  730. 20440 CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT,TRUE)
  731. 20450 IF OK THEN _
  732.          GOTO 20452
  733.       GOTO 20475
  734. 20451 A$ = "Invalid file name"
  735.       GOTO 20395
  736. 20452 IF USER.SECURITY.LEVEL < OVERWRITE.SECURITY.LEVEL THEN _
  737.          GOTO 20453
  738.       A$ = "Overwrite file (Y,[N])"
  739.       GOSUB 21660
  740.       IF FILESYS.PARAMETER > 1 THEN _
  741.          RETURN
  742.       IF NOT YES THEN _
  743.          GOTO 20453
  744.       Z$ = FILE.NAME$
  745.       CALL KILLWORK (FILE.NAME$)
  746.       IF EC <> 0 THEN _
  747.          EL = 20452 : _
  748.          GOTO 21900
  749.       GOTO 20475
  750. 20453 CLOSE 2
  751.       IF USER.SECURITY.LEVEL < ADD.DIR.SECURITY THEN _
  752.          CALL QTPUT ("Thanks, but we already have " + FILE.NAME.HOLD$,1) : _
  753.          CALL UPDTCALR ("Upload duplicate " + FILE.NAME.HOLD$,1) : _
  754.          RETURN
  755.       A$ = "Add new directory entry (Y,[N])"
  756.       TURBO.KEY = - TURBO.KEY.USER
  757.       GOSUB 21660
  758.       IF FILESYS.PARAMETER > 1 THEN _
  759.          RETURN
  760.       IF NOT YES THEN _
  761.          RETURN
  762.       ADDING.DESC.ONLY = TRUE
  763.       GOSUB 20702
  764.       RETURN
  765. 20475 Z$ = UPLOAD.DRIVE.FILE$
  766.       CALL FINDFREE
  767.       IF VAL(FREE.SPACE$) < 4096 THEN _
  768.          CALL QTPUT ("No room for uploads.  Try tomorrow.",1) : _
  769.          ANS.INDEX = LAST.UPLOAD + 1 : _
  770.          RETURN
  771.       A$ = "Upload disk has" + _
  772.            FREE.SPACE$
  773.       GOSUB 21640
  774.       IF FILESYS.PARAMETER > 1 THEN _
  775.          RETURN
  776.       LINE.25$ = "(U) " + _
  777.                  FILE.NAME.HOLD$
  778.       SUBROUTINE.PARAMETER = 2
  779.       CALL LINE25
  780.       A$ = ""
  781.       OK = TRUE
  782. 20477 CALL XFERTYPE (2,TRUE)
  783.       IF FF THEN _
  784.          GOTO 20500
  785.       CALL XFERTYPE (1,TRUE)
  786.       IF SUBROUTINE.PARAMETER = -1 THEN _
  787.          RETURN
  788. 20500 TRANSFER.FUNCTION = 2
  789.       AUTODOWNLOAD.IN.PROGRESS = FALSE
  790.       GOSUB 21790
  791.       IF FILESYS.PARAMETER > 1 THEN _
  792.          RETURN
  793.       ON INSTR("AXCYN",INTERNAL.PROTO$) GOTO _
  794.          20560, _         ' ASCII UPLOAD
  795.          20542, _         ' XMODEM
  796.          20542, _         ' XMODEM CRC
  797.          20542, _         ' YMODEM
  798.          20735            ' NONE - CANCEL
  799.       GOTO 20261
  800. 20510 D$ = "<Esc> by SYSOP aborts"
  801.       GOSUB 21710
  802.       RETURN
  803. 20515 CALL SVIOLATION
  804.       IF DENY.ACCESS THEN _
  805.          FILESYS.PARAMETER = 4 : _
  806.          RETURN
  807.       GOTO 20420
  808. '
  809. ' *  XMODEM/YMODEM UPLOAD DRIVER
  810. '
  811. 20542 A1$ = "RECEIVE"
  812.       GOSUB 20320
  813.       IF FILESYS.PARAMETER > 1 THEN _
  814.          RETURN
  815.       OK = TRUE
  816.       GOSUB 20860
  817.       IF FILESYS.PARAMETER > 1 THEN _
  818.          RETURN
  819.       IF OK THEN _
  820.          GOTO 20700
  821.       GOTO 20730
  822. '
  823. ' *  ASCII UPLOAD                                                             *
  824. '
  825. 20560 LINE.ACK = (DEFAULT.LINE.ACK$ <> "")
  826.       IF LINE.ACK THEN _
  827.          A$ = "Acknowledge each line ([Y],N)" : _
  828.          TURBO.KEY = - TURBO.KEY.USER : _
  829.          GOSUB 21660 : _
  830.          LINE.ACK = NOT NO : _
  831.          IF FILESYS.PARAMETER > 1 THEN _
  832.             RETURN
  833.       CALL QTPUT("Transfer MUST end with a <Ctrl-K>",1)
  834.       CALL QTPUT(PROTO.PROMPT$+" RECEIVE of " + FILE.NAME.HOLD$ + " ready",1)
  835.       OK = FALSE
  836.       XOFF = FALSE
  837.       CALL OPENOUTW(FILE.NAME$)
  838.       IF EC <> 0 AND EC <> 53 THEN _
  839.          EL = 20560 : _
  840.          GOTO 21900
  841.       GOSUB 20510
  842.       IF FILESYS.PARAMETER > 1 THEN _
  843.          RETURN
  844. 20600 CALL EOFCOMM (CHAR%)
  845.       WHILE CHAR% <> -1
  846.          CALL CARRIER
  847.          IF SUBROUTINE.PARAMETER THEN _
  848.             FILESYS.PARAMETER = 7 : _
  849.             RETURN
  850.          IF NOT FOSSIL THEN _
  851.             IF LOF(3) < 512 THEN _
  852.                CALL PUTCOM(XOFF$) : _
  853.                XOFF = TRUE
  854. 20610    CALL FLUSHCOM (X$)
  855.          IF SUBROUTINE.PARAMETER = -1 THEN _
  856.             RETURN
  857.          IF INSTR(X$,CHR$(11)) THEN _
  858.             GOTO 20650
  859.          OK = TRUE
  860. 20620    CALL PRINTWRK (X$)
  861.          IF LINE.ACK THEN _
  862.             IF INSTR(X$,CHR$(10)) > 0 THEN _
  863.                CALL PUTCOM (DEFAULT.LINE.ACK$)
  864.          IF EC <> 0 THEN _
  865.             EL = 20620 : _
  866.             GOTO 21900
  867.          D$ = X$
  868.          NUM.RETURNS = 0
  869.          GOSUB 21720
  870.          IF FILESYS.PARAMETER > 1 THEN _
  871.             RETURN
  872. 20621    CALL FINDFUNC
  873.          IF SUBROUTINE.PARAMETER < 0 THEN _
  874.             FILESYS.PARAMETER = 2 : _
  875.             RETURN
  876.          IF KEY.PRESSED$ = ESCAPE$ THEN _
  877.             GOTO 20745
  878.          IF NOT OK THEN _
  879.             GOTO 20670
  880.       CALL EOFCOMM (CHAR%)
  881. 20630 WEND
  882.       CALL CARRIER
  883.       IF SUBROUTINE.PARAMETER THEN _
  884.          FILESYS.PARAMETER = 7 : _
  885.          RETURN
  886.       IF XOFF THEN _
  887.          XOFF = FALSE : _
  888.          CALL PUTCOM (XON$) : _
  889.          IF EC <> 0 THEN _
  890.             EL = 20630 : _
  891.             GOTO 21900
  892.       GOTO 20600
  893. 20650 X = INSTR(X$,CHR$(11))
  894.       IF X = 1 THEN _
  895.          IF NOT OK THEN _
  896.             GOTO 20730 _
  897.          ELSE GOTO 20700
  898.       CALL PRNTWRKA (LEFT$(X$,X-1))
  899.       IF EC <> 0 THEN _
  900.          EL = 20650 : _
  901.          GOTO 21900
  902.       GOTO 20700
  903. 20670 A$ = XOFF$ + _
  904.            "System error! Upload aborted <Ctrl-K> continues"
  905. 20675 GOSUB 21650
  906.       IF FILESYS.PARAMETER > 1 THEN _
  907.          RETURN
  908.       CALL DELAYIT (3)
  909.       CALL PUTCOM(XON$)
  910. 20680 CALL EOFCOMM (CHAR%)
  911.       WHILE CHAR% <> -1
  912.          CALL FLUSHCOM(X$)
  913.          IF INSTR(X$,CHR$(11)) THEN _
  914.             GOTO 20730
  915. 20685    CALL CARRIER
  916.          IF SUBROUTINE.PARAMETER = -1 THEN _
  917.             FILESYS.PARAMETER = 7 : _
  918.             RETURN
  919.       CALL EOFCOMM (CHAR%)
  920.       WEND
  921.       GOTO 20680
  922. '
  923. ' *  UPDATE UPLOAD DIRECTORY                                                  *
  924. '
  925. 20700 GOSUB 21780
  926.       IF FILESYS.PARAMETER > 1 THEN _
  927.          RETURN
  928. 20702 CALL UPDTUPLOAD (CATEGORY.NAME$(),CATEGORY.CODE$(), LINES.IN.MESSAGE)
  929.       IF NOT GET.EXT.DESC THEN _
  930.          GOTO 20710
  931.       FT$ = "Extended Description for " + FILE.NAME.HOLD$
  932.       SYSOP.COMMENT = TRUE
  933.       MAX.MESSAGE.LINES = MAX.EXTENDED.LINES
  934.       LL = RIGHT.MARGIN : _
  935.       RIGHT.MARGIN = 30 + MAX.DESC.LEN : _
  936.       GOTO 21600
  937. 20705 MAX.MESSAGE.LINES = MAX.MESSAGE.LINES.DEF
  938.       RIGHT.MARGIN = LL
  939.       GOTO 20702
  940. 20710 IF ADDING.DESC.ONLY THEN _
  941.          ADDING.DESC.ONLY = FALSE : _
  942.          RETURN
  943.       IF BYTES.IN.FILE# > 0.0 THEN _
  944.          GOTO 21770
  945. 20730 GOSUB 21780
  946.       CALL QTPUT ("Upload aborted",1)
  947. 20735 CALL KILLWORK (FILE.NAME$)
  948.       IF EC <>0 THEN _
  949.          EL = 20736 : _
  950.          GOTO 21900
  951.       RETURN
  952. '
  953. ' *  SYSOP ABORTED UPLOAD                                                     *
  954. '
  955. 20745 A$ = XOFF$ + _
  956.            "SYSOP aborted upload. Stop tranfer. <Ctrl-K> continues"
  957.       GOTO 20675
  958. '
  959. ' *  CALCULATE DOWNLOAD TIME ESTIMATE                                         *
  960. '
  961. 20750 START.OF.HEADER$ = CHR$(1 - (INTERNAL.PROTO$ = "Y"))
  962.       CALL OPENRSEQ (FILE.NAME$,MAX.BLOCK,DF,FLEN)
  963. 20760 BYTES.IN.FILE# = LOF(2)
  964.       NUM.DNLD.BYTS! = LOF(2)
  965.       OK = TRUE
  966.       IF SIZE.ONLY THEN _
  967.          SIZE.ONLY = FALSE : _
  968.          RETURN
  969.       BLOCKS.IN.FILE# = MAX.BLOCK
  970.       IF BATCH.TRANSFER THEN _
  971.          BATCH.BYTES# = BATCH.BYTES# + BYTES.IN.FILE# : _
  972.          BATCH.BLOCKS# = BATCH.BLOCKS# + BLOCKS.IN.FILE# : _
  973.          CALL OPENWRKA (NODE.WORK.FILE$) : _
  974.          CALL PRNTWRKA (FILE.NAME$) : _
  975.          RETURN
  976. 20780 A$ = "File Size    :"
  977.       OK = TRUE
  978.       IF BLOCK.SIZE > 0 THEN _
  979.          A$ = A$ + _
  980.               STR$(FIX(BLOCKS.IN.FILE#)) + _
  981.               " blocks "
  982. 20785 BLOCKS.IN.FILE# = BLOCKS.IN.FILE# / _
  983.                         VAL(MID$("0000030004501200240048009601920", -4 * BPS, 4))
  984.       BLOCKS.IN.FILE# = BLOCKS.IN.FILE# * FLEN / SPEED.FACTOR!
  985.       IF (DWN.INDEX > 1 AND CONCAT.FILES) THEN _
  986.          RETURN
  987.       A$ = A$ + _
  988.            STR$(BYTES.IN.FILE#) + _
  989.            " bytes"
  990.       GOSUB 21650
  991.       IF FILESYS.PARAMETER > 1 THEN _
  992.          RETURN
  993.       IF BYTES.IN.FILE# < 1 THEN _
  994.          RETURN
  995. 20790 SUBROUTINE.PARAMETER = 2
  996.       CALL LINE25
  997.       A$ = "Transfer Time:" + _
  998.          STR$(INT(BLOCKS.IN.FILE# / 60)) + _
  999.          " min," + _
  1000.          STR$(INT(BLOCKS.IN.FILE# - (INT(BLOCKS.IN.FILE# / 60) * 60))) + _
  1001.          " sec (approx)"
  1002.       GOSUB 21650
  1003.       IF FILESYS.PARAMETER > 1 THEN _
  1004.          RETURN
  1005. 20791 IF PERSONAL.DOWNLOAD THEN _
  1006.          RETURN
  1007.       CALL CHKTREMAIN (TIME.REMAINING!)
  1008.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1009.          FILESYS.PARAMETER = 6 : _
  1010.          RETURN
  1011.       OK = TRUE
  1012.       IF (INT(BLOCKS.IN.FILE# / 60) + 1) > INT(TIME.REMAINING!) THEN _
  1013.          A$ = "Not enough time left!" : _
  1014.          CALL UPDTCALR (FILE.NAME$ + " " + A$,2) : _
  1015.          CALL QTPUT (A$,1): _
  1016.          A$ = "" : _
  1017.          OK = FALSE : _
  1018.          RETURN
  1019.       CALL CHECKRATIO (TRUE)
  1020.       RETURN
  1021. 20810 CALL SETABORT (DELAY!,6)
  1022. 20840 CALL EOFCOMM (CHAR%)
  1023.       IF CHAR% = -1 THEN _
  1024.          GOTO 20850
  1025.       CALL FLUSHCOM(Y$)
  1026.       RETURN
  1027. 20850 CALL CHECKTIM (DELAY!)
  1028.       ON SUBROUTINE.PARAMETER GOTO 20840,20851
  1029. 20851 Y$ = ""
  1030.       CALL CARRIER
  1031.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1032.          FILESYS.PARAMETER = 7 : _
  1033.          RETURN
  1034.       RETURN
  1035. '
  1036. ' *  XMODEM/YMODEM UPLOAD                                                     *
  1037. '
  1038. 20860 GOSUB 20992
  1039.       IF FILESYS.PARAMETER > 1 THEN _
  1040.          RETURN
  1041.       IF NOT EIGHT.BIT THEN _
  1042.          GOSUB 21280 : _
  1043.          IF FILESYS.PARAMETER > 1 THEN _
  1044.             RETURN
  1045. 20900 X$ = ""
  1046.       SEC = 1
  1047.       'CALL OPENOUTW (FILE.NAME$)
  1048.       IF FLEN > WRITE.BUF.DEF THEN _
  1049.          WRITE.BUF = FLEN _
  1050.       ELSE WRITE.BUF = WRITE.BUF.DEF
  1051.       CALL OPENRSEQ (FILE.NAME$,Y,DF,WRITE.BUF)
  1052.       IF EC <> 0 AND EC <> 53 THEN _
  1053.          EL = 20900 : _
  1054.          GOTO 21900
  1055.       FIELD #2, WRITE.BUF AS UPLOAD.RECORD$
  1056.       RECS.WRIT = 0
  1057.       NUM.IN.BUFF = 0
  1058.       CALL SETABORT (TRANSFER.ABORT!,WAIT.BEFORE.DISCONNECT)
  1059.       YY$ = " " + _
  1060.             CHR$(1) + _
  1061.             CHR$(2) + _
  1062.             END.TRANSMISSION$ + _
  1063.             CANCEL$
  1064. 20903 CALL PUTCOM (NEGATIVE.ACKNOWLEDGE$)
  1065. 20920 X = 1
  1066. 20922 CALL CARRIER
  1067.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1068.          FILESYS.PARAMETER = 7 : _
  1069.          RETURN
  1070.       CALL FINDFUNC
  1071.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1072.          GOSUB 20510 :_
  1073.          IF FILESYS.PARAMETER > 1 THEN _
  1074.             RETURN _
  1075.          ELSE GOTO 21240
  1076.       GOSUB 20810
  1077.       IF FILESYS.PARAMETER > 1 THEN _
  1078.          RETURN
  1079. 20930 J = INSTR(YY$,LEFT$(Y$,1))
  1080.       ON J GOTO 20960,20999,20999,21220,21230
  1081. 20960 IF Y$ <> "" THEN _
  1082.          GOSUB 21280 : _
  1083.          IF FILESYS.PARAMETER > 1 THEN _
  1084.             RETURN _
  1085.          ELSE CALL CHECKTIM (TRANSFER.ABORT!) : _
  1086.          ON SUBROUTINE.PARAMETER GOTO 20920,21230
  1087. 20970 X = X + 1
  1088.       CALL DELAYIT (1)
  1089.       CALL PUTCOM (NEGATIVE.ACKNOWLEDGE$)
  1090.       IF X < 6 THEN _
  1091.          GOTO 20922
  1092.       D$ = "Upload Timeout"
  1093.       GOSUB 21710
  1094.       IF FILESYS.PARAMETER > 1 THEN _
  1095.          RETURN
  1096.       CALL CHECKTIM (TRANSFER.ABORT!)
  1097.       ON SUBROUTINE.PARAMETER GOTO 20990,21230
  1098. 20990 GOTO 20920
  1099. '
  1100. ' *  CHANGE TO 8 BIT FOR XMODEM                                               *
  1101. '
  1102. 20992 GOSUB 20510
  1103.       IF FILESYS.PARAMETER > 1 THEN _
  1104.          FILESYS.PARAMETER = 2 : _
  1105.          RETURN
  1106.       IF NOT EIGHT.BIT THEN _
  1107.          PREV.LINE.CONTROL = INP (LINE.CONTROL.REGISTER) : _
  1108.          CALL DELAYIT (3) : _
  1109.          SWITCHED.TO.EIGHT = TRUE : _
  1110.          OUT LINE.CONTROL.REGISTER,3
  1111. 20996 SO = 0
  1112.       RETURN
  1113. '
  1114. ' *  EXPECTED BLOCK LENGTH. 132 FOR CHECKSUM, 133 FOR CRC, 1029 FOR YMODEM    *
  1115. '
  1116. 20999 SOL = 896 * J - 1659 + CHECKSUM
  1117.       DATA.SOL = 128 - (SOL > 1024)*896
  1118.       GOTO 21020
  1119. '
  1120. ' *  XMODEM/YMODEM UPLOAD                                                     *
  1121. '
  1122. 21000 GOSUB 20810
  1123.       IF FILESYS.PARAMETER > 1 THEN _
  1124.          RETURN
  1125.       IF Y$ = "" THEN _
  1126.          D$ = "Upload Timeout" : _
  1127.          GOSUB 21710 : _
  1128.          IF FILESYS.PARAMETER > 1 THEN _
  1129.             RETURN _
  1130.          ELSE GOTO 21040
  1131. 21020 X$ = X$ + _
  1132.            Y$
  1133.       IF LEN(X$) < SOL THEN _
  1134.          GOTO 21000
  1135. 21040 IF LEN(X$) = SOL THEN _
  1136.          GOTO 21090
  1137. 21050 IF LEN(X$) > SOL THEN _
  1138.          GOTO 21180
  1139. 21060 IF X$ = END.TRANSMISSION$ THEN _
  1140.          GOTO 21220
  1141. 21070 IF X$ = CANCEL$ THEN _
  1142.          GOTO 21230
  1143. 21080 GOTO 21170
  1144. 21090 JX = ASC(MID$(X$,2,1))
  1145.       IF SEC = JX THEN _
  1146.          GOTO 21100
  1147.       IF SEC > JX THEN _
  1148.          CALL PUTCOM (ACKNOWLEDGE$) : _ 'RIGHT$(ACKC$,1 - (JX = 0))) : _
  1149.          GOTO 21150
  1150.       GOTO 21200
  1151. 21100 IF (SEC XOR 255) <> ASC(MID$(X$,3,1)) THEN _
  1152.          GOTO 21210
  1153. 21110 IF CHECKSUM THEN _
  1154.          WK$ = MID$(X$,4,128) : _
  1155.          GOSUB 21750 : _
  1156.          IF FILESYS.PARAMETER > 1 THEN _
  1157.             RETURN _
  1158.          ELSE IF XMODEM.CHECKSUM <> ASC(MID$(X$,132,1)) THEN _
  1159.             GOTO 21190 _
  1160.          ELSE GOTO 21120
  1161.       WK$ = MID$(X$,4)
  1162.       GOSUB 21750
  1163.       IF FILESYS.PARAMETER > 1 THEN _
  1164.          RETURN
  1165. 21113 IF CRC.VALUE <> 0 THEN _
  1166.          GOTO 21191
  1167. 21120 SO = SO + 1
  1168.       CALL PUTCOM (ACKNOWLEDGE$)
  1169. 21131 IF NUM.IN.BUFF >= WRITE.BUF THEN _
  1170.          NUM.IN.BUFF = 0 : _
  1171.          CALL PUTWORK (UPLOAD.RECORD$,RECS.WRIT,WRITE.BUF) : _
  1172.          IF EC <> 0 THEN _
  1173.             EL = 21131 : _
  1174.             GOTO 21900
  1175.       MID$(UPLOAD.RECORD$,NUM.IN.BUFF+1,DATA.SOL) = WK$
  1176.       NUM.IN.BUFF = NUM.IN.BUFF + DATA.SOL
  1177. 21145 SEC = 255 AND (SEC + 1)
  1178.       CALL QLPRNT ("OK Rec Blk #",SO)
  1179. 21150 X$ = ""
  1180.       XMODEM.CHECKSUM = 0
  1181.       CALL SETABORT(TRANSFER.ABORT!,45)
  1182.       GOTO 20920
  1183. 21170 A$ = "Short Blk #"
  1184.       GOTO 21212
  1185. 21180 A$ = "Long Blk #"
  1186.       GOTO 21212
  1187. 21190 A$ = "Chksum Error #"
  1188.       GOTO 21212
  1189. 21191 A$ = "CRC Error"
  1190.       GOTO 21212
  1191. 21200 A$ = "Blk # Error in #"
  1192.       JX = ASC(MID$(X$,2,1))
  1193.       IF SEC < JX THEN _
  1194.          GOTO 21212
  1195.       CALL PUTCOM (ACKNOWLEDGE$) ' RIGHT$(ACKC$,1 - (JX = 0)))
  1196.       GOTO 21150
  1197. 21210 A$ = "Complement Error in #"
  1198. 21212 GOSUB 21280
  1199.       IF FILESYS.PARAMETER > 1 THEN _
  1200.          RETURN
  1201.       CALL PUTCOM (NEGATIVE.ACKNOWLEDGE$)
  1202.       CALL LPRNT(LINE.FEED$ + A$ + STR$(SO + 1),0)
  1203.       GOTO 21150
  1204. 21220 IF NUM.IN.BUFF < 1 THEN _
  1205.          GOTO 21225
  1206.       WK$ = LEFT$(UPLOAD.RECORD$,NUM.IN.BUFF)
  1207.       CALL OPENRSEQ (FILE.NAME$,MAX.BLOCK,DF,128)
  1208.       FIELD #2, 128 AS UPLOAD.RECORD$
  1209.       MAX.BLOCK = CDBL(RECS.WRIT) * WRITE.BUF / 128
  1210.       FOR I = 1 TO NUM.IN.BUFF/128
  1211.          CALL PUTWORK (MID$(WK$,128*I-127,128),MAX.BLOCK,128)
  1212.          IF EC > 0 THEN _
  1213.             EL = 21220 : _
  1214.             GOTO 21900
  1215.       NEXT
  1216.       CLOSE 2
  1217. 21225 CALL PUTCOM (ACKNOWLEDGE$)
  1218.       GOTO 21250
  1219. 21230 D$ = LINE.FEED$ + _
  1220.            "Transfer Aborted"
  1221.       GOSUB 21710
  1222.       IF FILESYS.PARAMETER > 1 THEN _
  1223.          RETURN
  1224. 21240 CALL EOFCOMM (CHAR%)
  1225.       IF CHAR% <> -1 THEN _
  1226.          GOSUB 21280 : _
  1227.          IF FILESYS.PARAMETER > 1 THEN _
  1228.             RETURN _
  1229.          ELSE CALL DELAYIT (1) : _
  1230.          GOTO 21240
  1231.       CALL PUTCOM (CANCEL$ + CANCEL$)
  1232.       CALL DELAYIT (1)
  1233.       CALL EOFCOMM (CHAR%)
  1234.       IF CHAR% <> -1 THEN _
  1235.          GOTO 21240
  1236.       OK = FALSE
  1237. 21250 EIGHT.BIT = TRUE
  1238.       RETURN
  1239. '
  1240. ' *  CLEAR GARBAGE OUT OF COMMUNICATIONS BUFFER                               *
  1241. '
  1242. 21280 CALL CARRIER
  1243.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1244.          FILESYS.PARAMETER = 7 : _
  1245.          RETURN
  1246.       CALL EOFCOMM (CHAR%)
  1247.       IF CHAR% = -1 THEN _
  1248.          RETURN
  1249. 21281 CALL FLUSHCOM(DF$)
  1250.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1251.          RETURN
  1252.       GOTO 21280
  1253. '
  1254. ' *  XMODEM/YMODEM DOWNLOAD
  1255. '
  1256. 21300 GOSUB 20992
  1257.       IF FILESYS.PARAMETER > 1 THEN _
  1258.          RETURN
  1259.       SEC = 0
  1260.       GOSUB 21280
  1261.       IF FILESYS.PARAMETER > 1 THEN _
  1262.          RETURN
  1263.       NEGATIVE.ACKNOWLEDGE$ = CHR$(21)
  1264.       CALL SETABORT (TRANSFER.ABORT!,WAIT.BEFORE.DISCONNECT)
  1265. 21303 FIELD 2,FLEN AS DOWNLOAD.RECORD$
  1266. '
  1267. ' *  ROUTINE TO START AN "XMODEM" OR "YMODEM" DOWNLOAD.  CHECK'S INITIAL      *
  1268. ' *  "HANDSHAKE" TO SEE IF CHARACTER IS SENT IS A:                            *
  1269. ' *           "X" = XMODEM WITH CHECKSUM AND 128 CHARACTER RECORDS            *
  1270. ' *           "C" = XMODEM WITH CRC CHECK AND 128 CHARACTER RECORDS           *
  1271. ' *           "Y" = YMODEM WITH CRC CHECK AND 1024 CHARACTER RECORDS          *
  1272. '
  1273. 21350 CALL EOFCOMM (CHAR%)
  1274.       WHILE CHAR% <> -1
  1275. 21360    CALL GETCOM(Y$)
  1276.          IF Y$ = CANCEL$ THEN _
  1277.             GOTO 21560
  1278. 21380    CHECKSUM = (Y$ = NEGATIVE.ACKNOWLEDGE$)
  1279.          IF CHECKSUM THEN _
  1280.             FF = INSTR(INTERNAL.EQUIV$,"X") : _
  1281.             IF FF > 0 THEN _
  1282.                FT$ = MID$(DFLTXFER$,FF,1) : _
  1283.                GOTO 21480 _
  1284.             ELSE FT$ = "X" : _
  1285.                  GOTO 21480 _
  1286.          ELSE IF Y$ = "C" THEN _
  1287.                  GOTO 21480
  1288.          CALL EOFCOMM (CHAR%)
  1289. 21390 WEND
  1290.       GOSUB 21460
  1291.       IF FILESYS.PARAMETER > 1 THEN _
  1292.          RETURN
  1293.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1294.          RETURN
  1295.       CALL CHECKTIM (TRANSFER.ABORT!)
  1296.       ON SUBROUTINE.PARAMETER GOTO 21350,21455
  1297. 21410 CALL SETABORT (TRANSFER.ABORT!, WAIT.BEFORE.DISCONNECT)
  1298. '
  1299. ' *  ROUTINE TO WAIT FOR AN ACKNOWLEDGEMENT ON AN "XMODEM" OR "YMODEM"        *
  1300. ' *  DOWNLOAD                                                                 *
  1301. '
  1302. 21415 CALL EOFCOMM (CHAR%)
  1303.       IF CHAR% <> -1 THEN _
  1304.          GOTO 21420
  1305.       GOSUB 21460
  1306.       IF FILESYS.PARAMETER > 1 THEN _
  1307.          RETURN
  1308.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1309.          RETURN
  1310.       CALL CHECKTIM (TRANSFER.ABORT!)
  1311.       ON SUBROUTINE.PARAMETER GOTO 21415,21455
  1312. 21420 CALL GETCOM(Y$)
  1313.       IF Y$ = ACKNOWLEDGE$ THEN _
  1314.          GOTO 21470
  1315. 21440 IF Y$ <> NEGATIVE.ACKNOWLEDGE$ THEN _
  1316.          GOTO 21450
  1317. 21443 D$ = LINE.FEED$ + _
  1318.          "Error -> retrans #" + _
  1319.          STR$(SO)
  1320.       GOSUB 21710
  1321.       IF FILESYS.PARAMETER > 1 THEN _
  1322.          RETURN
  1323. 21445 SO = SO - 1
  1324.       GOTO 21490
  1325. 21450 IF Y$ = CANCEL$ THEN _
  1326.          IF HAVE.A.CANCEL THEN _
  1327.             GOTO 21560 _
  1328.          ELSE HAVE.A.CANCEL = TRUE
  1329.       CALL CHECKTIM (TRANSFER.ABORT!)
  1330.       ON SUBROUTINE.PARAMETER GOTO 21415,21455
  1331. 21455 D$ = "Download timeout"
  1332.       GOSUB 21710
  1333.       IF FILESYS.PARAMETER > 1 THEN _
  1334.          RETURN
  1335.       GOTO 21560
  1336. 21460 CALL CARRIER
  1337.       CALL FINDFUNC
  1338.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1339.          FILESYS.PARAMETER = 7 : _
  1340.          RETURN
  1341.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1342.          GOTO 21540
  1343.       RETURN
  1344. '
  1345. ' *  DISPLAY BLOCK SENT OK AND THEN READ IN NEXT RECORD FROM DISK TO DOWNLOAD *
  1346. '
  1347. 21470 CALL QLPRNT ("OK Sent Blk #",SO)
  1348. 21480 IF LOC(2) => MAX.BLOCK THEN _
  1349.          GOTO 21530
  1350.       CALL GETWORK (FLEN)
  1351.       IF EC <> 0 THEN _
  1352.          EL = 21480 : _
  1353.          GOTO 21900
  1354.       SEC = 255 AND (SEC + 1)
  1355.       GOTO 21490
  1356. '
  1357. ' *  ROUTINE TO WRITE OUT AN "XMODEM" OR "YMODEM" RECORD TO THE COMM. PORT    *
  1358. '
  1359. 21490 SO = SO + 1
  1360.       CALL PUTCOM (START.OF.HEADER$ + CHR$(SEC) + CHR$(SEC XOR 255))
  1361.       CALL PUTCOM (DOWNLOAD.RECORD$)
  1362.       HAVE.A.CANCEL = FALSE
  1363. 21503 WK$ = DOWNLOAD.RECORD$
  1364. 21504 GOSUB 21750
  1365.       IF FILESYS.PARAMETER > 1 THEN _
  1366.          RETURN
  1367. 21510 IF CHECKSUM THEN _
  1368.          CALL PUTCOM(CHR$(XMODEM.CHECKSUM)) _
  1369.       ELSE CALL PUTCOM(CHR$(CRC.HIGH) + CHR$(CRC.LOW))
  1370.       GOSUB 21280
  1371.       IF FILESYS.PARAMETER > 1 THEN _
  1372.          RETURN
  1373.       GOTO 21410
  1374. '
  1375. ' *  END-OF-FILE FOR XMODEM DOWNLOADS -- SEND THE "EOT" CHARACTER AND WAIT UP *
  1376. ' *  TO 2 SECONDS FOR A POSITIVE RESPONSE (I.E. AN "ACK").  IF NONE IS        *
  1377. ' *  RE-TRY UP TO 10 TIMES.  IF NO POSITIVE RESPONSE IS RECEIVED AFTER TEN    *
  1378. ' *  ATTEMPTS, ASSUME THE DOWNLOAD WAS UNSUCCESSFULL.                         *
  1379. '
  1380. 21530 CALL PUTCOM (END.TRANSMISSION$)
  1381.       X = 1
  1382. 21531 GOSUB 20810
  1383.       IF FILESYS.PARAMETER > 1 THEN _
  1384.          RETURN
  1385.       IF INSTR(Y$,ACKNOWLEDGE$) THEN _
  1386.          GOTO 21550
  1387.       CALL FINDFUNC
  1388.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1389.          FILESYS.PARAMETER = 2 : _
  1390.          RETURN
  1391.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1392.          GOSUB 21540 : _
  1393.          GOTO 21545
  1394.       IF X < 10 THEN _
  1395.          X = X + 1 : _
  1396.          GOTO 21531
  1397.       DOWNLOAD.COMPLETED = FALSE
  1398.       GOTO 21230
  1399. 21540 GOSUB 20510
  1400.       IF FILESYS.PARAMETER > 1 THEN _
  1401.          RETURN
  1402.       RETURN
  1403. 21545 Y$ = CANCEL$
  1404.       CALL PUTCOM (CANCEL$ + CANCEL$ + CANCEL$)
  1405.       DOWNLOAD.COMPLETED = FALSE
  1406.       GOTO 21250
  1407. 21550 DOWNLOAD.COMPLETED = TRUE
  1408.       GOTO 21250
  1409. 21560 DOWNLOAD.COMPLETED = FALSE
  1410.       D$ = LINE.FEED$ + _
  1411.            "Caller aborted trans"
  1412.       GOSUB 21710
  1413.       IF FILESYS.PARAMETER > 1 THEN _
  1414.          RETURN
  1415.       GOTO 21545
  1416. '
  1417. ' Exit to main-line RBBS-PC and go to handle exit (line  202)
  1418. '
  1419. 21570 FILESYS.PARAMETER = 2
  1420.       GOTO 21920
  1421. '
  1422. ' Exit to main-line RBBS-PC and go to command processing (line 1200)
  1423. '
  1424. 21580 FILESYS.PARAMETER = 3
  1425.       GOTO 21920
  1426. '
  1427. ' Exit to main-line RBBS-PC and deny the user access (line 1380)
  1428. '
  1429. 21590 FILESYS.PARAMETER = 4
  1430.       GOTO 21920
  1431. '
  1432. ' Exit to put in extended description and then return (line 2008)
  1433. '
  1434. 21600 FILESYS.PARAMETER = 5
  1435.       GOTO 21920
  1436. '
  1437. ' Exit to main-line RBBS-PC because time limit exceeded (line 10553)
  1438. '
  1439. 21610 FILESYS.PARAMETER = 6
  1440.       GOTO 21920
  1441. '
  1442. ' Exit to main-line RBBS-PC because loss of carrier (line 10595)
  1443. '
  1444. 21620 FILESYS.PARAMETER = 7
  1445.       GOTO 21920
  1446. '
  1447. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL OUTPUT ROUTIN
  1448. '
  1449. ' Modeled on lines 12975 to 12983 in RBBS-PC.BAS
  1450. 21630 SUBROUTINE.PARAMETER = 1
  1451.       GOTO 21655
  1452. 21640 SUBROUTINE.PARAMETER = 3
  1453.       GOTO 21655
  1454. 21650 SUBROUTINE.PARAMETER = 5
  1455. 21655 CALL TPUT
  1456.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1457.          FILESYS.PARAMETER = 2 : _
  1458.          RETURN
  1459.       IF SUBROUTINE.PARAMETER = 8 THEN _
  1460.          GOSUB 21660
  1461.       RETURN
  1462. '
  1463. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL INPUT ROUTINE
  1464. '
  1465. ' Modeled on lines 12995 to 12997 in RBBS-PC.BAS
  1466. 21660 SUBROUTINE.PARAMETER = 1
  1467.       CALL TGET
  1468.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1469.          FILESYS.PARAMETER = 2
  1470.       RETURN
  1471. 21700 EC = 0
  1472.       RETURN
  1473. '
  1474. ' **** COMMON LOCAL DISPLAY PRINT ****
  1475. '
  1476. '  (formerly lines 1315 to 1320 in RBBS-PC.BAS CPC16-1A
  1477. 21710 NUM.RETURNS = 1
  1478. 21720 CALL LPRNT (D$,NUM.RETURNS)
  1479.       RETURN
  1480. '
  1481. ' *  XMODEM / CRC INTERFACE                                                   *
  1482. '
  1483. '  (formerly line 46000 in RBBS-PC.BAS CPC16-1A
  1484. 21750 XMODEM.CHECKSUM = 0
  1485.       CRC.VALUE = 0
  1486.       CALL XMODEM(WK$,XMODEM.CHECKSUM,CRC.VALUE,CRC.HIGH,CRC.LOW)
  1487.       RETURN
  1488. '
  1489. ' * UPDATE DOWNLOAD STATISTICS                                                *
  1490. '
  1491. '  (formerly lines 50600 to 50614 in RBBS-PC.BAS CPC16-1A
  1492. 21760 GOSUB 21780
  1493.       IF FILESYS.PARAMETER > 1 THEN _
  1494.          RETURN
  1495.       IF NOT DOWNLOAD.COMPLETED THEN _
  1496.          DF$ = " Aborted" _
  1497.       ELSE CALL LOGDOWN (PERSONAL.DOWNLOAD,DWN.INDEX) : _
  1498.            DOWNLOADS = DOWNLOADS + 1 : _
  1499.            DLBYTES! = DLBYTES! + NUM.DNLD.BYTS! : _
  1500.            DL.TODAY! = DL.TODAY! + 1 : _
  1501.            BYTES.TODAY! = BYTES.TODAY! + NUM.DNLD.BYTS! : _
  1502.            NUM.DNLD.BYTS! = 0 : _
  1503.            CALL MUZAK (6) : _
  1504.            DF$ = " Downloaded" : _
  1505.            IF (DWN.INDEX = LAST.DOWNLOAD OR NOT CONCAT.FILES) THEN _
  1506.               CALL SKIPLINE (1) : _
  1507.               CALL QTPUT ("Download successful",1)
  1508.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  1509.          DF$ = " AUTO" + _
  1510.               MID$(N$,2)
  1511.       IF INSTR(N$,"Aborted") THEN _
  1512.          AUTODOWNLOAD.IN.PROGRESS = 0
  1513.       A$ = ""
  1514. 21770 SUBROUTINE.PARAMETER = 2
  1515.       CALL AMORPM
  1516.       IF NOT BATCH.TRANSFER THEN _
  1517.          GOTO 21773
  1518.       CALL OPENWORK (NODE.WORK.FILE$)
  1519.       IF EC > 0 THEN _
  1520.          RETURN
  1521.       Q = 0
  1522.       WHILE NOT EOF(2)
  1523.          CALL READANY
  1524.          Q = Q + 1
  1525.          B$(Q) = A$
  1526.       WEND
  1527. 21772 IF Q < 1 THEN _                                                ' DTM0828
  1528.          BATCH.TRANSFER = FALSE : _
  1529.          RETURN
  1530.       CALL OPENWORK (B$(Q))
  1531.       IF EC > 0 THEN _
  1532.          EC = 0 : _
  1533.          Q = Q - 1 : _
  1534.          GOTO 21772
  1535.       BYTES.IN.FILE# = LOF(2)
  1536.       FILE.NAME$ = B$(Q)
  1537. 21773 CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,TRUE)
  1538.       Z$ = X$ + _
  1539.            EXTENTION$ + _
  1540.            DF$ + _
  1541.            " at " + _
  1542.            TIM$ + _
  1543.            " using " + _
  1544.            FT$ + _
  1545.            STR$(BYTES.IN.FILE#)
  1546.       CALL UPDTCALR (Z$,2)
  1547.       CALL CHECKRATIO (FALSE)
  1548.       IF BATCH.TRANSFER THEN _
  1549.          Q = Q - 1 : _
  1550.          GOTO 21772
  1551. 21774 IF MENU.INDEX = 6 THEN _
  1552.          IF DOWNLOAD.COMPLETED THEN _
  1553.             A$ = X$ : _
  1554.             SUBROUTINE.PARAMETER = 5 : _
  1555.             CALL LIBRARY
  1556.       RETURN
  1557. '
  1558. ' *****   TURN ON INTERMEDIATE ECHO   *****
  1559. '
  1560. '  (formerly line 50620 in RBBS-PC.BAS CPC16-1A
  1561. 21780 IF ECHOER$ = "I" THEN _
  1562.          CALL SETECHO ("I")
  1563. '
  1564. ' *  RESTORE COMMUNICATIONS AFTER SWITCH TO 8 BIT                             *
  1565. '
  1566. '  (formerly between lines 50620 and 50630 in RBBS-PC.BAS CPC16-1A
  1567.       IF SWITCHED.TO.EIGHT THEN _
  1568.          IF SWITCH.BACK THEN _
  1569.             OUT LINE.CONTROL.REGISTER, PREV.LINE.CONTROL : _
  1570.             CALL DELAYIT (3) : _
  1571.             EIGHT.BIT = FALSE : _
  1572.             SWITCHED.TO.EIGHT = FALSE
  1573.       RETURN
  1574. '
  1575. ' *****  TURN OFF INTERMEDIATE ECHO  *****
  1576. '
  1577. '  (formerly line 50630 in RBBS-PC.BAS CPC16-1A
  1578. 21790 IF ECHOER$ = "I" THEN _
  1579.          CALL SETECHO ("R")
  1580.       RETURN
  1581. '
  1582. ' *****   DIRECTORY SEARCH   *****
  1583. '
  1584. '  (formerly lines 52900 to 52920 in RBBS-PC.BAS CPC16-1A
  1585. 21800 CK = 2
  1586.       IF Q > 1 THEN _
  1587.          GOTO 21820
  1588. 21810 A$ = "Search for (in file name/desc, wildcards name only, [ENTER] quits)"
  1589.       GOSUB 21660
  1590.       IF FILESYS.PARAMETER > 1 THEN _
  1591.          RETURN
  1592.       IF Q = 0 THEN _
  1593.          RETURN
  1594.       B$(2) = B$(1)
  1595. 21820 RS$ = B$(2)
  1596.       WILD.SEARCH = (INSTR(RS$,"*") > 0 OR INSTR(RS$,"?") > 0)
  1597.       CALL ALLCAPS (RS$)
  1598.       SEARCH.STRING$ = RS$
  1599.       SEARCH.DATE$ = ""
  1600.       A1$ = RS$
  1601.       GOTO 21867
  1602. '
  1603. ' *****  P - personal download  *****
  1604. '
  1605. '  (formerly lines 52950 to 52952 in RBBS-PC.BAS CPC16-1A
  1606. 21850 IF PERSONAL.BEGIN < 1 OR PERSONAL.LEN < 1 THEN _
  1607.          RETURN
  1608.       DOWNLOAD.FLAG = 0
  1609.       PERSONAL.DOWNLOAD = TRUE
  1610. 21852 CALL PERSFILE (MID$(USER.RECORD$,PERSONAL.BEGIN,PERSONAL.LEN),_
  1611.                      DOWNLOAD.FLAG)
  1612.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1613.          RETURN
  1614.       IF Q <= 0 THEN _
  1615.          GOTO 21854
  1616.       CONCAT.FILES = PERSONAL.CONCAT
  1617.       STOP.INTERRUPTS = TRUE
  1618.       TIME.LOCK.EXEMPT = TRUE
  1619.       GOSUB 20202
  1620.       IF FILESYS.PARAMETER > 1 THEN _
  1621.          GOTO 21854
  1622.       TIME.LOCK.EXEMPT = FALSE
  1623.       CONCAT.FILES = FALSE
  1624.       GOTO 21852
  1625. 21854 PERSONAL.DOWNLOAD = FALSE
  1626.       RETURN
  1627. '
  1628. ' *  N - COMMAND FROM FILES MENU (DISPLAY NEW FILES SINCE LAST DIR DISPLAY)   *
  1629. '
  1630. '  (formerly lines 53000 to 53070 in RBBS-PC.BAS CPC16-1A
  1631. 21860 CK = 1
  1632.       IF Q > 1 THEN _
  1633.          GOTO 21865
  1634. 21862 A1$ = RIGHT$(LM$,4) +_
  1635.             LEFT$(LM$,2)
  1636.       A$ = "Files on/after (MMDDYY, [ENTER] = last on " + _
  1637.            A1$ + _
  1638.            ")"
  1639.       GOSUB 21660
  1640.       IF FILESYS.PARAMETER > 1 THEN _
  1641.          RETURN
  1642.       IF Q = 0 THEN _
  1643.          RS$ = LM$ : _
  1644.          GOTO 21866
  1645.       B$(2) = B$(1)
  1646. 21865 IF LEN(B$(2)) <> 6 THEN _
  1647.          GOTO 21862
  1648.       A1$ = B$(2)
  1649.       RS$ = RIGHT$(A1$,2) + _
  1650.             LEFT$(A1$,4)
  1651. 21866 SEARCH.DATE$ = RS$
  1652.       SEARCH.STRING$ = ""
  1653. 21867 IF Q > 2 THEN _
  1654.          DIR.INDEX = 3 : _
  1655.          GOTO 21871
  1656. 21870 CALL GETDIRS (NOT EXPERT.USER)
  1657.       IF Q = 0 THEN _
  1658.          RETURN
  1659.       DIR.INDEX = 1
  1660. 21871 CALL CONVDIRS (DIR.INDEX)
  1661.       LAST.DIR.POS = Q
  1662.       LIST.DIRECTORY = TRUE
  1663.       LIST.NEW = TRUE
  1664. 21875 Z$ = B$(DIR.INDEX)
  1665.       IF Z$ = "ALL" THEN _
  1666.          IF NOT LIMIT.SEARCH.TO.FMS THEN _
  1667.             GOTO 21890
  1668. 21880 LIST.INDEX = DIR.INDEX
  1669.       QX = LIST.INDEX
  1670.       GOSUB 20160
  1671.       IF FILESYS.PARAMETER > 1 THEN _
  1672.          RETURN
  1673.       DIR.INDEX = DIR.INDEX + 1
  1674.       IF DIR.INDEX <= LAST.DIR.POS THEN _
  1675.          GOTO 21875
  1676.       LIST.NEW = FALSE
  1677.       SEARCH.STRING$ = ""
  1678.       SEARCH.DATE$ = ""
  1679.       RETURN
  1680. 21890 G = DIR.INDEX
  1681.       LIST.INDEX = DIRECTORY.INDEX + 1
  1682.       CALL GETALL (DIRECTORY.PATH$ + DIRECTORY.PREFIX$ + "." + DIRECTORY.EXTENTION$,B$(),DIRECTORY.EXTENTION$,G)
  1683.       SEARCHING.ALL = TRUE
  1684.       QX = G
  1685.       LIST.INDEX = DIR.INDEX + 1
  1686.       GOTO 20160
  1687. '
  1688. ' *  MAIN FILE SYSTEM ERROR TRAP - ALL ERRORS PASS THROUGH THIS ROUTINE
  1689. '
  1690. '  (formerly lines 13000 to 13500 in RBBS-PC.BAS CPC16-1A
  1691. 21900 IF DEBUG THEN _
  1692.          A$ = "RBBSSUB5 DEBUG Error Trap Entry ERL=" + _
  1693.               STR$(EL) + _
  1694.               " ERR=" + _
  1695.               STR$(EC) : _
  1696.          IF PRINTER THEN _
  1697.             CALL PRINTIT(A$) _
  1698.          ELSE CALL LPRNT(A$,1)
  1699.       IF EL = 20126 AND EC = 53 THEN _
  1700.          GOTO 20142
  1701.       IF EL = 20242 AND EC = 62 THEN _
  1702.          CALL UPDTCALR (FILESEC.FILE$ + " bad format!",2) : _
  1703.          GOTO 20247
  1704.       IF EL = 20262 THEN _
  1705.          A$ = "<Download aborted>" : _
  1706.          DOWNLOAD.COMPLETED = FALSE : _
  1707.          GOTO 20390
  1708.       IF EL = 20452 AND EC = 53 THEN _
  1709.          GOTO 20451
  1710.       IF EL = 20560 AND EC = 67 THEN _
  1711.          GOTO 20451
  1712.       IF EL = 20560 AND EC = 70 THEN _
  1713.          IF VAL(FREE.SPACE$) > 1999 THEN _
  1714.             GOTO 20610 _
  1715.          ELSE CALL QTPUT ("No room for uploads. Try tomorrow.",1) : _
  1716.               GOTO 21700
  1717.       IF EL = 20620 THEN _
  1718.          GOTO 20670
  1719.       IF EL = 20650 THEN _
  1720.          GOTO 20670
  1721.       IF EL = 20736 AND EC = 53 THEN _
  1722.          GOTO 21700
  1723.       IF EL = 20900 AND EC = 75 THEN _
  1724.          GOTO 21230
  1725.       IF EL = 20900 AND EC = 70 THEN _
  1726.          CALL QTPUT ("No room for uploads. Try tomorrow.",1) : _
  1727.          GOTO 21230
  1728.       IF EL = 21131 OR EL = 21220 THEN _
  1729.          EC = 0 : _
  1730.          GOTO 21230
  1731.       IF EL = 21480 THEN _
  1732.          CALL LOGERROR : _
  1733.          IF EC = 57 THEN _
  1734.             CALL QTPUT("Error reading file.  Aborting download",1) : _
  1735.             DOWNLOAD.COMPLETED = FALSE : _
  1736.             GOTO 21230
  1737. 21910 CALL LOGERROR
  1738.       CALL QTPUT (CALLERS.RECORD$,1)
  1739.       FILESYS.PARAMETER = 3
  1740.       RETURN
  1741. 21920 ' EXIT RBBS-PC FILE SUBSYSTEM
  1742.       END SUB
  1743.